home *** CD-ROM | disk | FTP | other *** search
Option Explicit Global Const MaxRows = 100 Global Const MaxCols = 100 Global Const MaxSheets = 10 Global Const MaxValues = 30 Global DirectoryForApplication As String Global SelectedLanguage As String Global CurrentLanguage As Integer Global AtLeastOneValidDrive As Integer Global SelectedDrive As String * 1 Global DirectoryTest As String Global Rows As Long Global Cols As Long Global Sheets As Long Type tagTypTest 'definition for type'd test Int As Integer Lng As Long Snl As Single Dbl As Double Stg As String * 14 End Type Dim StrTest As String * 14 Dim TypTest As tagTypTest Dim DA(1 To 6) As tagDISKARRAY Sub BigArrayInit () Dim ErrCode As Integer ' disable the form cDisableFI frmBig1.Picture1 ' make a directory on the selected drive for test, ' don't take care of the returned error if the directory ' already exist ErrCode = cMakeDir(DirectoryTest) ' clear the list for initialization frmBig1.List1.Clear ' initialize each type of variable, see InitBigInteger for explain Call InitBigInteger Call InitBigLong Call InitBigSingle Call InitBigDouble Call InitBigString Call InitBigTyped ' enable the form cEnableFI frmBig1.Picture1 End Sub Sub DeleteDemoFiles () Dim i As Integer Dim ErrCode As Integer ' close all arrays (in not already closed) and delete it For i = 1 To 6 Call cDAClose(DA(i), True) Next i ' remove the test directory ErrCode = cKillDir(DirectoryTest) End Sub Sub DisplayMessage (Frm As Form, TextOrder As String, InsertText As String) ' display a multi-language message box, message are centered ' and a timeout of 16 seconds is displayed. Call cLngBoxMsg(CurrentLanguage, ReadText(Frm, TextOrder, InsertText), MB_MESSAGE_CENTER Or MB_TIMEOUT_16 Or MB_DISPLAY_TIMEOUT Or 32, "BIG DISK ARRAY") End Sub Sub InitBigDouble () ' see explain in InitBigInteger Dim ErrCode As Integer DA(4).nFilename = DirectoryTest + "\dadouble.tmp" DA(4).nType = DA_DOUBLE DA(4).nIsTyped = False DA(4).nRows = Rows DA(4).nCols = Cols DA(4).nSheets = Sheets ErrCode = cDACreate(DA(4), True) If (ErrCode = DA_NO_ERROR) Then frmBig1.List1.AddItem ReadText(frmBig1, "IS", "DOUBLE" & "~" & Trim$(DA(4).nFilename) & "~" & DA(4).rFileSize & "~" & DA(4).rTime) Else frmBig1.List1.AddItem ReadText(frmBig1, "IF", "DOUBLE" & "~" & ErrCode) End If Call cDAClose(DA(4), False) frmBig1.List1.Refresh End Sub Sub InitBigInteger () Dim ErrCode As Integer ' name of the file to store the array DA(1).nFilename = DirectoryTest + "\daint.tmp" ' type of the array DA(1).nType = DA_INTEGER ' is the array, an array of type'd variable DA(1).nIsTyped = False ' maximum number of rows DA(1).nRows = Rows ' maximum number of cols DA(1).nCols = Cols ' maximum number of sheets DA(1).nSheets = Sheets ' create the big array (full initialization) and use it ErrCode = cDACreate(DA(1), True) ' check if an error has occured when initializing If (ErrCode = DA_NO_ERROR) Then ' no error, what's a chance, display a success message ' + name of the file ' + size of the file ' + time for initialization frmBig1.List1.AddItem ReadText(frmBig1, "IS", "INTEGER" & "~" & Trim$(DA(1).nFilename) & "~" & DA(1).rFileSize & "~" & DA(1).rTime) Else ' error, number of the error is displayed frmBig1.List1.AddItem ReadText(frmBig1, "IF", "INTEGER" & "~" & ErrCode) End If ' close the big array Call cDAClose(DA(1), False) frmBig1.List1.Refresh End Sub Sub InitBigLong () ' see explain in InitBigInteger Dim ErrCode As Integer DA(2).nFilename = DirectoryTest + "\dalong.tmp" DA(2).nType = DA_LONG DA(2).nIsTyped = False DA(2).nRows = Rows DA(2).nCols = Cols DA(2).nSheets = Sheets ErrCode = cDACreate(DA(2), True) If (ErrCode = DA_NO_ERROR) Then frmBig1.List1.AddItem ReadText(frmBig1, "IS", "LONG" & "~" & Trim$(DA(2).nFilename) & "~" & DA(2).rFileSize & "~" & DA(2).rTime) Else frmBig1.List1.AddItem ReadText(frmBig1, "IF", "LONG" & "~" & ErrCode) End If Call cDAClose(DA(2), False) frmBig1.List1.Refresh End Sub Sub InitBigSingle () ' see explain in InitBigInteger Dim ErrCode As Integer DA(3).nFilename = DirectoryTest + "\dasingle.tmp" DA(3).nType = DA_SINGLE DA(3).nIsTyped = False DA(3).nRows = Rows DA(3).nCols = Cols DA(3).nSheets = Sheets ErrCode = cDACreate(DA(3), True) If (ErrCode = DA_NO_ERROR) Then frmBig1.List1.AddItem ReadText(frmBig1, "IS", "SINGLE" & "~" & Trim$(DA(3).nFilename) & "~" & DA(3).rFileSize & "~" & DA(3).rTime) Else frmBig1.List1.AddItem ReadText(frmBig1, "IF", "SINGLE" & "~" & ErrCode) End If Call cDAClose(DA(3), False) frmBig1.List1.Refresh End Sub Sub InitBigString () ' see explain in InitBigInteger Dim ErrCode As Integer DA(5).nFilename = DirectoryTest + "\dastring.tmp" DA(5).nType = Len(StrTest) DA(5).nIsTyped = False DA(5).nRows = Rows DA(5).nCols = Cols DA(5).nSheets = Sheets ErrCode = cDACreate(DA(5), True) If (ErrCode = DA_NO_ERROR) Then frmBig1.List1.AddItem ReadText(frmBig1, "IS", "STRING" & "~" & Trim$(DA(5).nFilename) & "~" & DA(5).rFileSize & "~" & DA(5).rTime) Else frmBig1.List1.AddItem ReadText(frmBig1, "IF", "STRING" & "~" & ErrCode) End If Call cDAClose(DA(5), False) frmBig1.List1.Refresh End Sub Sub InitBigTyped () ' see explain in InitBigInteger Dim ErrCode As Integer DA(6).nFilename = DirectoryTest + "\datyped.tmp" DA(6).nType = Len(TypTest) DA(6).nIsTyped = True DA(6).nRows = Rows DA(6).nCols = Cols DA(6).nSheets = Sheets ErrCode = cDACreate(DA(6), True) If (ErrCode = DA_NO_ERROR) Then frmBig1.List1.AddItem ReadText(frmBig1, "IS", "TYPE'D" & "~" & Trim$(DA(6).nFilename) & "~" & DA(6).rFileSize & "~" & DA(6).rTime) Else frmBig1.List1.AddItem ReadText(frmBig1, "IF", "TYPE'D" & "~" & ErrCode) End If Call cDAClose(DA(6), False) frmBig1.List1.Refresh End Sub Sub Loader () DoEvents Dim i As Integer Dim d As Integer Dim ErrCode As Integer Dim SplitPath As tagSPLITPATH ' change the language to the current language in the system menu of the current form Call cLngSysMenu(CurrentLanguage, frmBigArray.hWnd) ' some initializations CurrentLanguage = LNG_ENGLISH DirectoryForApplication = cGetIn(cEXEnameActiveWindow(), ".", 1) ' split the path of the application into four components ErrCode = cSplitPath(DirectoryForApplication, SplitPath) ' regenerate only the directory of the application DirectoryForApplication = SplitPath.nDrive + SplitPath.nDir ' set the default language SelectedLanguage = ".TUK" ' display a message before starting search of valid drive Call DisplayMessage(frmBigArray, "0", "") ' find all valid drives (C to Z) which can handle the demonstration For i = 3 To 26 ' get the type of the drive d = cGetDriveType(Chr$(64 + i)) ' test if the drive is valid If ((d <> DRIVE_UNKNOW) And (d <> DRIVE_CDROM)) Then ' drive is valid, now check the free disk space greater than 7 Mb If (cGetDiskFree(Chr$(64 + i)) > 7000000) Then frmBigArray.Combo1.AddItem Chr$(64 + i) End If End If Next i ' check if at least one drive is in the combo box 'drive' AtLeastOneValidDrive = (frmBigArray.Combo1.ListCount > 0) ' display a message box if no valid drive If (AtLeastOneValidDrive = False) Then Call DisplayMessage(frmBigArray, "1", "") Else frmBigArray.Combo1.ListIndex = 0 End If End Sub Sub Main () Load frmBigArray DoEvents frmBigArray.Show End Sub Function ReadText (Frm As Form, TextOrder As String, InsertText As String) As String Dim BasisText As String ' read the text in the language file BasisText = cGetIni("BigDiskArray", TextOrder, "?", DirectoryForApplication & Frm.Tag & SelectedLanguage) ' insert some text if any ReadText = cInsertBlocks(BasisText, InsertText) End Function Sub TestBig (ArrayNumber As Integer) Dim ErrCode As Integer Dim Row As Long Dim Col As Long Dim Sheet As Long Dim n As Integer Dim SaveData As Variant Dim ReadData As Variant Dim Tmp As String ' open/use the file for the array ErrCode = cDACreate(DA(ArrayNumber), False) ' check if no error has occured If (ErrCode = DA_NO_ERROR) Then 'no error ' clear the list for saved values frmBig1.List2.Clear ' clear the list for readed values frmBig1.List3.Clear ' set the random generator Randomize Timer ' generate 7 random data in random Row, Col and Sheet For n = 1 To MaxValues ' random Row Row = 1 + Int(Rows * Rnd) ' random Col Col = 1 + Int(Cols * Rnd) ' random Sheet Sheet = 1 + Int(Sheets * Rnd) ' *** save the values and dispay it ' check the type of the array Select Case DA(ArrayNumber).nType Case DA_INTEGER 'big array of integer ' generate a random integer SaveData = Int(32760 * Rnd) ' save the random into Row, Col, Sheet Call cDAPut(DA(ArrayNumber), Row, Col, Sheet, SaveData) ' display the saved value Case DA_LONG 'big array of long ' generate a random long SaveData = Int(2100000000 * Rnd) ' save the random into Row, Col, Sheet Call cDAPut(DA(ArrayNumber), Row, Col, Sheet, SaveData) Case DA_SINGLE 'big array of single ' generate a random single SaveData = 2100000000 * Rnd ' save the random into Row, Col, Sheet Call cDAPut(DA(ArrayNumber), Row, Col, Sheet, SaveData) Case DA_DOUBLE 'big array of double ' generate a random double SaveData = 4200000000# * Rnd ' save the random into Row, Col, Sheet Call cDAPut(DA(ArrayNumber), Row, Col, Sheet, SaveData) Case Else 'big array of string or type'd ' generate three random byte SaveData = 97 + (Int(26 * Rnd)) Tmp = Chr$(SaveData) SaveData = 97 + (Int(26 * Rnd)) Tmp = Tmp + Chr$(SaveData) SaveData = 97 + (Int(26 * Rnd)) Tmp = Tmp + Chr$(SaveData) ' fill the string with the byte above Call cFill(StrTest, Tmp) ' check array type If (DA(ArrayNumber).nIsTyped = False) Then ' big array of string ' save the random into Row, Col, Sheet Call cDAPut(DA(ArrayNumber), Row, Col, Sheet, StrTest) ' set this value for display SaveData = StrTest Else ' big array of type'd TypTest.Int = Int(32760 * Rnd) TypTest.Lng = Int(2100000000 * Rnd) TypTest.Snl = 2100000000 * Rnd TypTest.Dbl = 4200000000# * Rnd TypTest.Stg = StrTest ' save the type'd into Row, Col, Sheet Call cDAPutType(DA(ArrayNumber), Row, Col, Sheet, TypTest) End If End Select ' check if the type of variable is not a type'd variable If ((DA(ArrayNumber).nType < 0) Or ((DA(ArrayNumber).nType > 0) And (DA(ArrayNumber).nIsTyped = False))) Then ' not a type'd variable ' display the value, row, col, sheet, offset and time taken Tmp = Format$(n, "00") & "~" & SaveData & "~" & Row & "~" & Col & "~" & Sheet & "~" & DA(ArrayNumber).rOffset1 & "~" & DA(ArrayNumber).rTime frmBig1.List2.AddItem ReadText(frmBig1, "SV", Tmp) Else ' this a type'd variable ' display the value, row, col, sheet, offset and time taken Tmp = Format$(n, "00") & "~" & TypTest.Int & "," & TypTest.Stg & "," & "~" & Row & "~" & Col & "~" & Sheet & "~" & DA(ArrayNumber).rOffset1 & "~" & DA(ArrayNumber).rTime frmBig1.List2.AddItem ReadText(frmBig1, "SV", Tmp) End If ' *** read the values and dispay it ' check if the type of variable is not a type'd variable If ((DA(ArrayNumber).nType < 0) Or ((DA(ArrayNumber).nType > 0) And (DA(ArrayNumber).nIsTyped = False))) Then ' not a type'd variable ' read the random from Row, Col, Sheet ReadData = cDAGet(DA(ArrayNumber), Row, Col, Sheet) ' display row, col, sheet, value, offset and time taken Tmp = Format$(n, "00") & "~" & Row & "~" & Col & "~" & Sheet & "~" & ReadData & "~" & DA(ArrayNumber).rOffset1 & "~" & DA(ArrayNumber).rTime frmBig1.List3.AddItem ReadText(frmBig1, "RV", Tmp) Else ' this a type'd variable ' read the random from Row, Col, Sheet Call cDAGetType(DA(ArrayNumber), Row, Col, Sheet, TypTest) ' display row, col, sheet, value, offset and time taken Tmp = Format$(n, "00") & "~" & TypTest.Int & "," & TypTest.Stg & "," & "~" & Row & "~" & Col & "~" & Sheet & "~" & DA(ArrayNumber).rOffset1 & "~" & DA(ArrayNumber).rTime frmBig1.List3.AddItem ReadText(frmBig1, "SV", Tmp) End If Next n Else ' an error has occured when using the file array Call DisplayMessage(frmBig1, "0", ErrCode & "~" & Trim$(DA(ArrayNumber).nFilename)) End If ' close the array (in not already close) but without delete it Call cDAClose(DA(ArrayNumber), False) End Sub 
